The X-Philes (2nd Revision)

home *** CD-ROM | disk | FTP | other *** search

/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / rplxmpl.dir < prev next >

Wrap

File List | 1993-02-18 | 14KB | 951 lines

%%HP: T(3)A(D)F(.); DIR SETUP \<< CCD \->RPL EVAL \>> UP "(UP) ASSEMBLE %18 EQU #1CDF2 RPL :: CK0 GetMenu% %IP># 2 #=casedrop UPDIR DUP 60 #<ITE :: { %0 %0 %0 %3 %3 %3 %3 %3 %3 %0 %10 %10 %10 %10 %10 %10 %0 %0 %18 %0 %0 %0 %0 %0 %24 %24 %24 %0 %0 % 29 %0 % 31 % 32 %0 %0 % 35 % 35 % 37 % 35 %0 % 40.04 %0 % 42 % 42 % 42 % 42 % 42 % 42 % 42.02 % 42.02 % 40.02 % 40.02 % 42.02 % 42.02 % 42.03 % 42.03 % 42.03 % 42.03 % 42 } SWAP NTHELCOMP NOTcase %0 ; :: DROP %24 ; InitMenu% SetDA12NoCh ;" MON "(MON) ASSEMBLE 2NULLLAM{} EQU #36D5A RPL :: CK0NOLASTWD { 18 16 17 11 49 44 39 34 29 28 27 26 } { # 1 # FFFFF # 10 # FFFF0 # 100 # FFF00 # 1000 # FF000 # 10000 # F0000 # 70 # FFF90 } 2NULLLAM{} BIND NULL$ # 142 EXPAND ID MONpar DUPTYPEHSTR? ?SKIP :: DROP ' ID MONpar HXS 5 00100 OVER STO EVAL ; BEGIN BEGIN CODE GOSBVL =SAVPTR A=DAT1 A A=A+CON A,10 R0=A D0=A A=DAT0 A R1=A D1=D1+ #5 A=DAT1 A D1=A D1=D1+ #A LCHEX 00006 B=C A LBEDB6 LCHEX 00004 D=C A A=R0 D0=A D1=D1+ #8 LBEDC8 GOSUB LBEE33 D1=D1- #2 D=D-1 A GONC LBEDC8 D1=D1+ #C LCHEX 3A DAT1=C B D1=D1+ 2 LCHEX 0000F D=C A D0=D0- #5 A=DAT0 A D0=A LBEDF3 GOSUB LBEE33 D1=D1+ #2 D=D-1 A GONC LBEDF3 LCHEX 0A DAT1=C B D1=D1+ #2 A=R0 D0=A A=DAT0 A A=A+CON A,16 DAT0=A A B=B-1 A GONC LBEDB6 A=R0 D0=A A=R1 DAT0=A A GOVLNG =GETPTRLOOP LBEE33 C=0 B C=DAT0 1 LAHEX 30 C=C+A B LAHEX 39 ?C<=A B GOYES LBEE5A LAHEX 07 C=C+A B LBEE5A DAT1=C B D0=D0+ #1 RTN ENDCODE OVER 1 7 Disp5x7 ?ATTNQUIT GETTOUCH UNTIL H/W>KeyCode 1GETLAM 2GETLAM ROT #=POSCOMP NTHELCOMP ITE CODE GOSBVL =POP# GOSBVL =SAVPTR C=DAT1 A CD1EX D1=D1+ #A C=DAT1 A C=C+A A DAT1=C A GOVLNG =GPPushFLoop ENDCODE TRUE UNTIL DROP ABND ;" LBLD C$ 2926 (LBLD) ASSEMBLE Repeater EQU #51735 RPL :: CK0 POLSaveUI ERRSET :: FALSE 4 11 FALSE' :: 5GETLAM 21 #+ 6GETLAM 55 #+OVER 44 #+OVER 2DUP PIXON? IT 2SWAP PIXON PIXOFF ; ' :: 7GETLAM IT :: 3GETLAM EVAL ; GROB 12 400004000090606090 TOTEMPOB 5GETLAM 21 #+ 6GETLAM 55 #+ PIXON? ?SKIP INVGROB HARDBUFF 5GETLAM #1- 5 #* #1+ 6GETLAM #1- 5 #* 11 #+ GROB! ; ' :: 4 4 MAKEGROB 5GETLAM 21 #+ 6GETLAM 55 #+ PIXON? IT INVGROB HARDBUFF 5GETLAM #1- 5 #* #1+ 6GETLAM #1- 5 #* 11 #+ GROB! ; ' NULLLAM 7 NDUPN DOBIND ClrDA1IsStat RECLAIMDISP 3 0 $ "HP-48 GRAPHIC MENU LABEL MAKER" $>grob XYGROBDISP 110 $ "EXIT" MakeStdLabel 88 $ "\\->STK" MakeStdLabel 66 8 21 MAKEGROB INVGROB 44 $ "SBGR" MakeStdLabel 0 $ "TOG" MakeStdLabel TURNMENUOFF 5 ZERO_DO 56 SWAP XYGROBDISP LOOP 45 ZERO_DO INDEX@ #10+ 110 ZERO_DO INDEX@ OVER PIXON 5 +LOOP DROP 5 +LOOP 2GETEVAL ' :: $ "Y: " 6GETLAM #>$ &$ MakeInvLabel HARDBUFF 109 36 $ "X: " 5GETLAM #>$ &$ MakeInvLabel HARDBUFF 4PICK 16 GROB! GROB! ; ' :: 1 #=casedrop :: 11 ?CaseKeyDef :: TakeOver Repeater 11 :: 1GETLAM EVAL 6GETLAM #1- DUP#0=IT :: DROP 8 ; 6PUTLAM 2GETEVAL ; ; 16 ?CaseKeyDef :: TakeOver Repeater 16 :: 1GETLAM EVAL 5GETLAM #1- DUP#0=IT :: DROP 21 ; 5PUTLAM 2GETEVAL ; ; 17 ?CaseKeyDef :: TakeOver Repeater 17 :: 1GETLAM EVAL 6GETLAM #1+DUP 9 #= IT DROPONE 6PUTLAM 2GETEVAL ; ; 18 ?CaseKeyDef :: TakeOver Repeater 18 :: 1GETLAM EVAL 5GETLAM #1+DUP 22 #= IT DROPONE 5PUTLAM 2GETEVAL ; ; 25 ?CaseKeyDef :: TakeOver 7GETLAM ?SKIP :: 3GETLAM EVAL ; 2GETEVAL ; 1 ?CaseKeyDef :: TakeOver 0 56 $ "TOG" 7GETLAM NOT DUP 7PUTLAM Box/StdLabel XYGROBDISP 2GETEVAL ; 3 ?CaseKeyDef :: TakeOver HARDBUFF 22 56 OVER 5GETLAM #+OVER 6GETLAM #+ SUBGROB DUP TOTEMPOB INVGROB $ "Inv" >TAG SWAP $ "Reg" >TAG ; 5 ?CaseKeyDef :: TakeOver HARDBUFF 22 56 43 64 SUBGROB DUP TOTEMPOB INVGROB $ "Inv" >TAG SWAP $ "Reg" >TAG ; 6 ?CaseKeyDef :: TakeOver TRUE 4PUTLAM ; 45 ?CaseKeyDef :: TakeOver TRUE 4PUTLAM ; 40 #=casedrpfls DROPDEADTRUE ; 3 #=casedrop :: 45 #=casedrpfls DROPDEADTRUE ; 2DROP 'DoBadKeyT ; TrueTrue FALSE ONEFALSE' 4GETLAM 'ERRJMP POLSetUI POLKeyUI ABND TURNMENUON RECLAIMDISP ClrDAsOK ; ERRTRAP POLResUI&Err POLRestoreUI ; PBYTES "(PBYTES) ASSEMBLE PORTDUMP EQU #21922 RPL :: CK1NoBlame CKREAL COERCE PORTDUMP DUP#0=csedrp :: DROP %0 ; 0 SWAP ZERO_DO SWAP OSIZE #+ LOOP SWAPDROP UNCOERCE %2 %/ ;" \->rpl C$ 544 (\->rpl) ASSEMBLE EvalNoCK: EQU #18F6A RPL :: CK1NoBlame BEGIN 1LAMBIND ERRSET :: 1GETLAM ROMPTR 4D2 1 (\->RPL) TRUE ; ERRTRAP :: DropSysObs FALSE ; 1GETABND SWAP ITE DROPTRUE :: ERROR@ DUP#0=csedrp TRUE DUP GETTHEMESG SWAP # 70000 #=case :: DUP DISPSTATUS2 SWAPOVER SEP$NL SWAPDROP DUP $ ":" OVERLEN$ POS$REV #1+ OVERLEN$ SUB$ DOSTR> TWO{}N EvalNoCK: xINPUT FALSE ; $ "\\->RPL Error:\\010" SWAP&$ DISPSTATUS2 SetDA1Temp TRUE ; UNTIL ; DCD C$ 520 (DCD) :: CK1NoBlame DUPTYPERRP? NcaseTYPEERR ROMPTR 4C5 5 (OB\->) COERCE DUP#0=case SETSIZEERR DUP #2* 1LAMBIND BlankDA2 $ "Processing:\\010" DISPSTATUS2 #1+_ONE_DO 1GETLAM ROLL 1GETLAM ROLL DUP ID>$ DISPROW2 SWAP :: DUPTYPERRP? ?SEMI XEQTYPE %25 %= ITE :: ROMPTR 4D2 3 (COD\->) OVER ID>$ CHR_* >H$ ; :: ROMPTR 4D2 0 (RPL\->) OVER ID>$ CHR_LeftPar >H$ CHR_RightPar >T$ ; NEWLINE$&$ !insert$ ; SWAP LOOP 1GETABND #2/ UNCOERCE ROMPTR 4C5 6 (\->DIR) ; CCD C$ 445 (CCD) :: 0LASTOWDOB! CK0NOLASTWD $ "Processing:\\010" DISPSTATUS2 0 DOVARS DUP1LAMBIND LENCOMP #1+_ONE_DO 1GETLAM INDEX@ NTHCOMPDROP DUP ID>$ DISPROW2 DUP XEQRCL :: DUPTYPERRP? case2DROP DUPTYPECSTR? IT :: DUP DUPNULL$? ITE DROPZERO CAR$ CHR># 40 #=casedrop ROMPTR 4D2 1 (\->RPL) 42 #<> ?SEMI ROMPTR 4D2 4 (\->COD) DROP ; SWAPROT #1+ ; LOOP ABND UNCOERCE ROMPTR 4C5 6 (\->DIR) ; tEVAL C$ 173 (tEVAL) :: CK1NoBlame GARBAGE CLKTICKS 1LAMBIND xEVAL CLKTICKS 1GETABND bit- HXS>% % 8.192 SWAPOVER %/ SWAP %- %3 RNDXY UNIT %1 CHR m $ "s" umP umEND ; UM>U ; FIXIT C$ 351 (FIXIT) :: CK1NoBlame DUPTYPECSTR? NcaseTYPEERR DUPONE 7 SUB$ $ "HPHP48-" EQUAL NcaseSIZEERR DUPLEN$ 8 #- #2* SWAP GARBAGE CODE C=DAT1 A CD1EX D1=D1+ #A D1=D1+ #10 CD1EX DAT1=C A LOOP ENDCODE DUP' xTYPE EvalNoCK %27 %= casedrop :: # 304 ERROROUT ; DUP OSIZE ROT #> casedrop :: # 12C ERROROUT ; AtUserStack TOTEMPOB ; ITYPE "(ITYPE, o \-> #) :: CK1NoBlame CODE GOSBVL =PopASavptr D1=A C=DAT1 A D=C A LCHEX 191B9 B=C A LCHEX 19128 A=0 A lp A=A+1 A D1=C C=DAT1 A ?D=C A GOYES ex D1=D1+ 5 CD1EX ?B>C A GOYES lp A=0 A GONC by ex C=0 A LCHEX F ?C>=A B GOYES by A=A-C A ASL A A=A!C A by GOVLNG =PUSH#ALOOP ENDCODE ;" cst C$ 899 (cst) { { :: PTR 3ECEE $ "5/7" 28 ; :: PTR 3ED84 28 ; } { :: TakeOver $ "Disassembler On/Off" DROP 4 SysITE GROB 3A 8000051000000000FFFFF118B30114440114550114440118B301FFFFF1 GROB 3A 8000051000000000FFFFF11000011000011000011CB701100001FFFFF1 ; :: PTR 3ED84 4 PTR 3919E ; } { :: PTR 3ECD0 $ "RPRT" 13 ; :: PTR 3ED84 13 PTR 3919E ; } PTR 3E84F (ML) { $ "CF1-8" :: TakeOver 8 #1+_ONE_DO INDEX@ ClrUserFlag LOOP SetDA2NoCh SetDA3NoCh ; } :: TakeOver ROMPTR 4D2 C (EC) ; ROMPTR 4C5 21 (STLIB) ROMPTR 4C5 20 (PGLIB) { $ "SEND" :: CK1NoBlame BlankDA12 xSEND xKERRM xCLOSEIO %0 InitMenu% DUPNULL$? caseDROP ; } { $ "RECV" :: CK0NOLASTWD BlankDA12 xRECV xKERRM xCLOSEIO %0 InitMenu% DUPNULL$? caseDROP ; } PTR 3EBAF (CLK) PTR 3BBA6 (BEEP) } DAR C$ 611 (DAR) :: CK1NoBlame DUPTYPEHSTR? NcaseTYPEERR ' :: 8 #1+_ONE_DO INDEX@ ClrUserFlag LOOP ; ' ROMPTR 4D2 7 (DA1) ROMPTR@ DROP OVER { NULLLAM NULLLAM } BIND EVAL DUPDUP BlankDA12 $ "Press <ENTER> to see next line" DispCoord1 BEGIN 2GETLAM EvalNoCK SWAP ABUFF 0 8 131 64 SUBGROB ABUFF ZEROZERO GROB! DISPROW7 WaitForKey DROP 45 #=casedrop :: 1GETABND EVAL ABORT ; 25 #<> UNTIL 1GETABND EVAL OVER HXS>$ $ "From: " !insert$ NEWLINE$&$ OVER HXS>$ $ "To : " !insert$ !append$ DISPSTATUS2 ROMPTR 4D2 8 (DAXY) SWAP HXS>$ $ "* " !insert$ NEWLINE$&$ !insert$ ; Strip "(Strip, o \-> o') :: CK1NoBlame ' :: ?ATTNQUIT DUPTYPELIST? case :: 1GETLAM EVAL {}N ; DUPTYPESYMB? case :: 1GETLAM EVAL SYMBN ; DUPTYPECOL? NOT?SEMI DUPLENCOMP #0=?SEMI DUP CARCOMP ' x<< EQ IT CDRCOMP DUP DUPLENCOMP NTHELCOMP NOT?SEMI ' x>> EQ IT :: DUPLENCOMP #1- ONESWAP SUBCOMP ; 1GETLAM EVAL ::N ; DUP ' :: INNERDUP DUP#0=csDROP ZERO_DO ROLL BEGIN { xENDTIC xIF xUNTIL } OVER ' EQ POSCOMP #0<> WHILE :: DROP ISTOP@ #1-DUP ISTOPSTO INDEX@ OVER#=case DROP ROLL ; REPEAT INHARDROM? ?SKIP 2GETEVAL ISTOP@ LOOP ; { NULLLAM NULLLAM } BIND EVAL ABND ;" GetKO C$ 144 (GtKO,\-> ob %) :: 0LASTOWDOB! CK0NOLASTWD BlankDA2 $ "Perform a keystroke\\031" DISPROW5 WaitForKey 2DUP Key>U/SKeyOb UNROT CodePl>%rc.p ; F&R "(F&R:$ $f $r \-> $) :: 0LASTOWDOB! CK3NOLASTWD CK&DISPATCH1 # 333 ($$$) :: UNROT 2DUP 1 POS$ DUP#0=case :: 2DROP SWAPDROP ; SWAP DUPLEN$ 5UNROLL 5UNROLL NULL$ UNROT BEGIN 2DUP 7PICK #+ OVERLEN$ SUB$ 5UNROLL #1-1SWAP SUB$ &$ OVER &$ ROTDUP 6PICK 1 POS$ DUP#0= UNTIL DROP &$ 4UNROLL3DROP ; ;" DBG "(DBG) :: HARDBUFF TOTEMPOB 1LAMBIND PTR 39BAD (DispStack) WaitForKey DROP ZEROZERO 1GETABND XYGROBDISP 25 (kcEnter) #= ?SEMI AtUserStack ABORT ;" Types "(Types) :: CK0NOLASTWD BlankDA2 13 18 GROB 398 320008600020003D00003E6E0EE4400776AE500805100801AA082011051AAA50083510080D6A0E688007366E5A2825100809AA082440041AA22A283D00003EAE0E20110716A2000000000000000000000000003208312118172E0AE85402726E2800215B1822510A24011512A42400117518227D0E64880732A4220801511822590824440512A47808075118125E082811151E64000000000000000000000000007C28300008359A3EE4C6037EA6428825200805B21224440512A4724830000815F21E6444033644122825200805D21824440512A47C8830100837921E2CD6031EAE000000000000000000000000007C38321E09351D0CE85D067EAE4A0825118A05151224451112A87C18371D8A121D0E64CD01364E482025198A05151A24451112A27E18357E09057D0E2855161EAE0000000000000000000000000056301656893A000EE8DD037EAE52282151090F100824451512A872283221091A0004644515364E42282421090F100224451512A8463823268B0A000228DD031EAE000000000000000000000000007C6815568B33370EE443077EAA144825510A05550A24450112AA76C817228B13370E644303364E444825548805510A24450112A87C6815538B05510E2C53071EA8 XYGROBDISP SetDA2OKTemp ;" Time "(Time) :: CK0NOLASTWD # FFFFF DUPDUP ' :: SWAP 10 #/ ROTSWAP #1+ 1GETSWAP NTHCOMPDROP HARDBUFF 3PICK 28 GROB! SWAP#1+ 1GETSWAP NTHCOMPDROP HARDBUFF ROT 11 #+ 28 GROB! ; { GROB 42 E0000A0000CF00CF00303030303C303C3033303330F030F03030303030CF00CF00 GROB 42 E0000A000003000300C300C30003000300030003000300030003000300CF00CF00 GROB 42 E0000A0000CF00CF0030303030003000300F000F00C000C00030003000FF30FF30 GROB 42 E0000A0000CF00CF003030303000300030CF00CF000030003030303030CF00CF00 GROB 42 E0000A00000C000C000F000F00CC00CC003C003C00FF30FF300C000C000C000C00 GROB 42 E0000A0000FF30FF3030003000FF00FF00003000300030003030303030CF00CF00 GROB 42 E0000A00000F000F00C000C00030003000FF00FF003030303030303030CF00CF00 GROB 42 E0000A0000FF30FF30003000300C000C0003000300C000C000C000C000C000C000 GROB 42 E0000A0000CF00CF003030303030303030CF00CF003030303030303030CF00CF00 GROB 42 E0000A0000CF00CF003030303030303030CF30CF30003000300C000C00C300C300 } ' NULLLAM 5 NDUPN DOBIND BlankDA2 49 28 GROB 22 C000040000000060F0F060000060F0F060 78 3PICK3PICK XYGROBDISP XYGROBDISP BEGIN GARBAGE TOD DUP %IP># 3GETLAM OVER#= ITE_DROP :: DUP 3PUTLAM 26 2GETEVAL ; %FP %10* %10* DUP %IP># 4GETLAM OVER#= ITE_DROP :: DUP 4PUTLAM 55 2GETEVAL ; %FP %10* %10* %IP># 5GETLAM OVER#= ITE_DROP :: DUP 5PUTLAM 84 2GETEVAL ; ?ATTNQUIT GETTOUCH UNTIL DROP ABND PTR 393D3 (SetDA1NoCh) SetDA3NoCh ;" END